home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / bytjl86a.arc / SPREAD.ARC / EVALUAT.MOD < prev    next >
Text File  |  1985-07-12  |  10KB  |  392 lines
  1. IMPLEMENTATION MODULE Evaluator;
  2.  
  3. (* Evaluator for the spreadsheet.
  4. *)
  5. (* grammar for formulas:  ( {} means "zero or more" )
  6.     <expr> ::= <valexpr> | <valexpr> <relop> <valexpr> | 
  7.                 IF  <expr> , <expr> , <expr> 
  8.     <valexpr> ::=   <term> { <addop> <term> }
  9.     <term> ::=  <factor>{ <mulop> <factor> }
  10.     <factor> ::= real | <cellref> |  - <factor> | ( <expr> ) 
  11.     <cellref> ::= [ <refexpr> , <refexpr> ]
  12.     <refexpr> ::= <addop> real | real
  13.     <relop> ::= < | > | = | <> | >= | <=
  14.     <addop> ::= + | -
  15.     <mulop> ::= * | /
  16.  
  17. 1 = TRUE, 0 = FALSE.
  18. *)
  19.  
  20. FROM Misc IMPORT fatal, assert;
  21. FROM Spreadsheet IMPORT maxRow, maxCol, Status, status, getValue;
  22. FROM StringStuff IMPORT string40, string160, stringCopy, findChar;
  23. FROM CharStuff IMPORT isDigit, isWhite;
  24. FROM RealConversions IMPORT StrToReal, RealProcResponses, RealConversionRes;
  25. FROM Formula IMPORT formula;
  26. IMPORT Formula;
  27. FROM DisplayHandler IMPORT message;
  28. FROM StringOps IMPORT Concat;
  29.  
  30. TYPE
  31.    relOpType = (Less, Greater, Equal, LessEqual, GreaterEqual, NotEqual);
  32.  
  33. VAR curRow, curCol:CARDINAL;
  34.  
  35. PROCEDURE evaluateFormula(f:formula;  row, col:CARDINAL; VAR v:REAL;
  36.                          VAR s:Status);
  37. VAR str:string160;
  38. BEGIN
  39.     Formula.toString(f, str);
  40.     evaluateString(str, row, col, v, s);
  41. END evaluateFormula;
  42.  
  43. PROCEDURE evaluateString(str:ARRAY OF CHAR; row, col:CARDINAL; VAR v:REAL; 
  44.                    VAR s:Status);
  45. VAR pos:CARDINAL;
  46. BEGIN
  47.     pos := 0;
  48.     curRow := row;
  49.     curCol := col;
  50.     expr(str, pos, v, s, TRUE);
  51. END evaluateString;
  52.  
  53.  
  54. (* <expr> ::= <valexpr> <relop> <valexpr> | IF  <expr> , <expr> , <expr> *)
  55. PROCEDURE expr(VAR str:ARRAY OF CHAR; VAR pos:CARDINAL; 
  56.  
  57.                VAR v:REAL; VAR s:Status; eval:BOOLEAN); 
  58. VAR v1:REAL;
  59.     rop:relOpType;
  60. BEGIN
  61.   IF nextChar(str, pos) THEN
  62.     IF (str[pos] = 'I') AND (str[pos+1] = 'F') THEN
  63.       INC(pos, 2);
  64.       ifexpr(str, pos, v, s, eval);
  65.     ELSE
  66.       valexpr(str, pos, v, s, eval);
  67.       IF s = OK THEN
  68.         IF nextChar(str, pos) THEN
  69.           relOp(str, pos, rop, s);
  70.           IF s <> OK THEN (* shouldn't have looked at next char *)
  71.             s := OK;
  72.           ELSE
  73.             valexpr(str, pos, v1, s, eval);
  74.             IF s = OK THEN
  75.               IF applyRelOp(rop, v, v1) THEN
  76.                 v := 1.0;
  77.               ELSE
  78.                 v := 0.0;
  79.               END;
  80.             END;
  81.           END;
  82.         END;
  83.       END;
  84.     END;
  85.   ELSE 
  86.     s := SyntaxError;
  87.     error(str, pos);
  88.   END;
  89. END expr;
  90.  
  91. (* IF <expr> , <expr> , <expr> *)
  92. PROCEDURE ifexpr(VAR str:ARRAY OF CHAR; VAR pos:CARDINAL; 
  93.                  VAR v:REAL; VAR s:Status; eval:BOOLEAN); 
  94. (* ifexpr has to eval both branches, even though it knows the
  95.    value of the test, because we do not separate parsing from evaluation. 
  96.    It doesn't cause a problem because there are no side-effects. *)
  97. VAR vTrue, vFalse:REAL;
  98. BEGIN
  99.   expr(str, pos, v, s, eval);
  100.   IF s = OK THEN
  101.     IF (NOT nextChar(str, pos)) OR (str[pos] <> ',') THEN
  102.       s := SyntaxError;
  103.       error(str, pos);
  104.     ELSE
  105.       INC(pos);
  106.       expr(str, pos,  vTrue, s, v <> 0.0);
  107.       IF s = OK THEN
  108.         IF (NOT nextChar(str, pos)) OR (str[pos] <> ',') THEN
  109.           s := SyntaxError;
  110.           error(str, pos);
  111.         ELSE
  112.  
  113.           INC(pos);
  114.           expr(str, pos, vFalse, s, v = 0.0);
  115.           IF s = OK THEN
  116.             IF v = 0.0 THEN
  117.               v := vFalse;
  118.             ELSE
  119.               v := vTrue;
  120.             END;
  121.           END;
  122.         END;
  123.       END;
  124.     END;
  125.   END;
  126. END ifexpr;
  127.  
  128. PROCEDURE relOp(VAR str:ARRAY OF CHAR; VAR pos:CARDINAL; 
  129.                 VAR rop:relOpType; VAR s:Status);
  130. BEGIN
  131.   IF str[pos] = '=' THEN
  132.     rop := Equal;
  133.     s := OK;
  134.     INC(pos);
  135.   ELSIF str[pos] = '>' THEN
  136.     IF str[pos+1] = '=' THEN
  137.       rop := GreaterEqual;
  138.       INC(pos, 2);
  139.       s := OK;
  140.     ELSE
  141.       rop := Greater;
  142.       s := OK;
  143.       INC(pos);
  144.     END;
  145.   ELSIF str[pos] = '<' THEN
  146.     IF str[pos+1] = '=' THEN
  147.       rop := LessEqual;
  148.       INC(pos, 2);
  149.       s := OK;
  150.     ELSE
  151.       rop := Less;
  152.       INC(pos);
  153.       s := OK;
  154.     END;
  155.   ELSE
  156.     s := SyntaxError; (* no message; this isn't a real error *)
  157.   END;
  158. END relOp;    
  159.             
  160. PROCEDURE applyRelOp(rop:relOpType; v1, v2:REAL):BOOLEAN;
  161. BEGIN
  162.     CASE rop OF
  163.         Equal:      RETURN v1 = v2;
  164.     |   NotEqual:   RETURN v1 <> v2;
  165.     |   Less:       RETURN v1 < v2;
  166.     |   Greater:    RETURN v1 > v2;
  167.     |   LessEqual:  RETURN v1 <= v2;
  168.  
  169.     |   GreaterEqual:   RETURN v1 >= v2;
  170.     ELSE
  171.         fatal('applyBoolOp: unknown op type');
  172.     END;
  173. END applyRelOp;         
  174.  
  175.     
  176. (* <valexpr> ::=   <term> { <addop> <term> }  *)
  177. PROCEDURE valexpr(VAR str:ARRAY OF CHAR; VAR pos:CARDINAL;
  178.                  VAR v:REAL; VAR s:Status; eval:BOOLEAN);
  179. VAR v1:REAL;
  180.     op:CHAR;
  181. BEGIN
  182.   term(str, pos, v, s, eval);
  183.   WHILE (s = OK) AND nextChar(str, pos) DO
  184.     IF NOT addOp(str[pos]) THEN
  185.       RETURN;
  186.     END;
  187.     op := str[pos];
  188.     INC(pos);
  189.     term(str, pos,  v1, s, eval);
  190.     IF (s = OK) AND eval THEN
  191.       IF op = '+' THEN
  192.         v := v + v1;
  193.       ELSE
  194.         v := v - v1;
  195.       END;
  196.     END;
  197.   END;
  198. END valexpr;
  199.       
  200. (*     <term> ::=  <factor>{ <mulop> <factor> }  *)
  201. PROCEDURE term(VAR str:ARRAY OF CHAR; VAR pos:CARDINAL; 
  202.                  VAR v:REAL; VAR s:Status; eval:BOOLEAN);
  203. VAR v1:REAL;
  204.     op:CHAR;
  205. BEGIN
  206.   factor(str, pos, v, s, eval);
  207.   WHILE (s = OK) AND nextChar(str, pos) DO
  208.     IF NOT mulOp(str[pos]) THEN
  209.       RETURN;
  210.     END;
  211.     op := str[pos];
  212.     INC(pos);
  213.     factor(str, pos, v1, s, eval);
  214.     IF (s = OK) AND eval THEN
  215.       IF op = '*' THEN
  216.         v := v * v1;
  217.       ELSIF v1 = 0.0 THEN
  218.         s := DivByZero;
  219.       ELSE
  220.         v := v / v1;
  221.       END;
  222.     END;
  223.   END;
  224.  
  225. END term;
  226.  
  227. (*  <factor> ::= real | <cellref> |  - <factor> | ( <expr> )   *)
  228. PROCEDURE factor(VAR str:ARRAY OF CHAR; VAR pos:CARDINAL;
  229.                  VAR v:REAL; VAR s:Status; eval:BOOLEAN);
  230. BEGIN
  231.   IF NOT nextChar(str, pos) THEN
  232.     s := SyntaxError;
  233.     error(str, pos);
  234.   ELSIF isDigit(str[pos]) THEN
  235.     parseReal(str, pos, v, s);
  236.   ELSE
  237.       INC(pos);
  238.       CASE str[pos-1] OF
  239.         '[': cellRef(str, pos, v, s, eval);
  240.       | '-': factor(str, pos, v, s, eval);
  241.              v := -v;
  242.       | '(': expr(str, pos, v, s, eval);
  243.              IF s = OK THEN
  244.                IF (NOT nextChar(str, pos)) OR (str[pos] <> ')') THEN
  245.                  s := SyntaxError;
  246.                  error(str, pos);
  247.                ELSE
  248.                  INC(pos);
  249.                END;
  250.              END;
  251.       ELSE
  252.         s := SyntaxError;
  253.         error(str, pos);
  254.       END;
  255.   END;
  256. END factor;
  257.  
  258. (*     <cellref> ::= [ <refexpr> , <refexpr> ] 
  259.     Opening [ is already read. *)
  260. PROCEDURE cellRef(VAR str:ARRAY OF CHAR; VAR pos:CARDINAL; 
  261.                  VAR v:REAL; VAR s:Status; eval:BOOLEAN);
  262. VAR vRow, vCol:REAL;
  263.     r, c:CARDINAL;
  264. BEGIN
  265.   refexpr(str, pos, vRow, s, curRow);
  266.   IF s = OK THEN
  267.     IF (NOT nextChar(str, pos)) OR  (str[pos] <> ',') THEN
  268.       s := SyntaxError;
  269.       error(str, pos);
  270.     ELSE
  271.       INC(pos);
  272.       refexpr(str, pos, vCol, s, curCol);
  273.       IF s = OK THEN
  274.         IF eval THEN
  275.           rangeCheck(vRow, vCol, r, c, s);
  276.         END;
  277.         IF s = OK THEN
  278.           IF eval THEN
  279.             reference(r, c, v, s);
  280.  
  281.           END;
  282.           IF s = OK THEN
  283.             IF nextChar(str, pos) AND (str[pos] = ']') THEN
  284.               INC(pos);
  285.             ELSE
  286.               s := SyntaxError;
  287.               error(str, pos);
  288.             END;
  289.           END;
  290.         END;
  291.       END;
  292.     END;
  293.   END;
  294. END cellRef;
  295.  
  296. (* <refexpr> ::= <addop> real | real *)
  297. PROCEDURE refexpr(VAR str:ARRAY OF CHAR; VAR pos:CARDINAL; 
  298.                  VAR v:REAL; VAR s:Status; addBase:CARDINAL);
  299. VAR op:CHAR;
  300. BEGIN
  301.   IF NOT nextChar(str, pos) THEN
  302.     s := SyntaxError;
  303.     error(str, pos);
  304.   ELSE
  305.     IF addOp(str[pos]) THEN
  306.       op := str[pos];
  307.       INC(pos);
  308.     ELSE
  309.       op := 0C;
  310.     END;
  311.     IF NOT nextChar(str, pos) THEN
  312.       s := SyntaxError;
  313.       error(str, pos);
  314.     ELSE
  315.       parseReal(str, pos, v, s);
  316.       IF s = OK THEN
  317.         IF op = '+' THEN
  318.           v := FLOAT(addBase) + v;
  319.         ELSIF op = '-' THEN
  320.           v := FLOAT(addBase) - v;
  321.         END;
  322.       END;
  323.     END;
  324.   END;
  325. END refexpr;
  326.  
  327.       
  328. PROCEDURE addOp(c:CHAR):BOOLEAN;
  329. BEGIN
  330.     RETURN (c = '+') OR (c = '-');
  331. END addOp;
  332.  
  333. PROCEDURE mulOp(c:CHAR):BOOLEAN;
  334. BEGIN
  335.     RETURN (c = '*') OR (c = '/');
  336.  
  337. END mulOp;
  338.  
  339. PROCEDURE rangeCheck(vRow, vCol:REAL; VAR r, c:CARDINAL; VAR s:Status);
  340. BEGIN
  341.   IF (vRow >= 1.0) AND (vRow <= FLOAT(maxRow())) AND
  342.      (vCol >= 1.0) AND (vCol <= FLOAT(maxCol())) THEN
  343.     s := OK;
  344.     r := TRUNC(vRow);
  345.     c := TRUNC(vCol);
  346.   ELSE
  347.     s := RangeError;
  348.   END;
  349. END rangeCheck;
  350.  
  351. PROCEDURE reference(row, col:CARDINAL; VAR v:REAL; VAR s:Status);
  352. BEGIN
  353.   IF status(row, col) = OK THEN
  354.     v := getValue(row, col);
  355.     s := OK;
  356.   ELSE
  357.     s := RefError;
  358.   END;
  359. END reference;
  360.  
  361. PROCEDURE parseReal(VAR str:ARRAY OF CHAR; VAR pos:CARDINAL; VAR v:REAL;
  362.                     VAR s:Status);
  363. VAR real,msg:string40;
  364.     endPos:CARDINAL;
  365. BEGIN
  366.   skipToEndOfReal(str, pos, endPos);
  367.   stringCopy(real, str, pos, endPos);
  368.   StrToReal(real, v);
  369.   CASE RealConversionRes OF
  370.     noError:    s := OK;
  371.   | invalidStr: s := SyntaxError;
  372.                 Concat(msg, "Invalid real: ", real);
  373.                 message(msg);
  374.   | overflow:   s := Overflow;
  375.   | underflow:  s := Underflow;
  376.   ELSE
  377.     fatal("parseReal: unknown error");
  378.   END;
  379.   pos := endPos+1;
  380. END parseReal;
  381.  
  382. PROCEDURE skipToEndOfReal(str:ARRAY OF CHAR; pos:CARDINAL;VAR endPos:CARDINAL);
  383. BEGIN
  384.   endPos := pos;
  385.   WHILE (endPos <= HIGH(str)) AND
  386.         findChar("0123456789E.", str[endPos], pos) DO
  387.     INC(endPos);
  388.   END;
  389.   DEC(endPos);
  390. END skipToEndOfReal;
  391.  
  392.